home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / pull5x.zip / PULLDATA.PAS < prev    next >
Pascal/Delphi Source File  |  1989-01-01  |  20KB  |  651 lines
  1. { =========================================================================== }
  2. { PullData.pas - User Statistics for data-entry windows.   ver 5.Xa, 01-11-89 }
  3. {                                                                             }
  4. { This file contains all the data to configure the data-entry fields in       }
  5. { data windows or work windows.                                               }
  6. {   Copyright (c) 1987-1989 James H. LeMay, All rights reserved.              }
  7. { =========================================================================== }
  8.  
  9. { R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }         { TP4 directives }
  10. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}    { TP5 directives }
  11.  
  12. {$define UseMsgLineCode }
  13.  
  14. UNIT PullData;
  15.  
  16. INTERFACE
  17.  
  18. uses
  19.   Crt,Qwik,Strs,Wndw,Pull,PullDir,PullStat;
  20.  
  21. { ================ Set up variables for data windows here: ================== }
  22. { Place your variables names here to interface with the menus.                }
  23. { Careful! -- there's NO type checking for parameters in Transfer.  You MUST  }
  24. { be certain case statement, DataWndw, and TypeOfData all match.  Be          }
  25. { especially careful of string lengths that are too long.  They can be no     }
  26. { longer than DataStrSize.                                                    }
  27. { --------------------------------------------------------------------------- }
  28.  
  29. const
  30.   aByte:      byte      =    129;
  31.   aWord:      word      =  50000;
  32.   aShortInt:  shortint  =    -10;
  33.   aInteger:   integer   = -31456;
  34.   aLongInt:   longint   = -123456789;
  35.   aReal:      real      = -24.34565E06;
  36.   aHex:       string[4] = 'FF03';
  37.   aChar:      char      = 'Q';
  38.   aString:    CrtStrType = 'This is a string';
  39.  
  40.   aByte2:     byte      =    219;
  41.   aWord2:     word      =  45600;
  42.   aShortInt2: shortint  =    -34;
  43.   aInteger2:  integer   =  -1100;
  44.   aLongInt2:  longint   = -98765432;
  45.   aReal2:     real      = -19.07070E12;
  46.   aHex2:      string[4] = 'FFFF';
  47.   aChar2:     char      = 'W';
  48.   aString2:   CrtStrType = 'This is another string';
  49.  
  50.   Seats:      byte      =      4;
  51.   Years:      byte      =     30;
  52.   Month:      byte      =      1;
  53.   Day:        byte      =     12;
  54.   Year:       integer   =   1989;
  55.   PriceLimit: integer   =   2000;
  56.  
  57. type
  58.   DataEntryNames = (
  59.     NoDE,aByte2DE,aWord2DE,aShortInt2DE,aInteger2DE,aLongInt2DE,aReal2DE,
  60.     aHex2DE,aChar2DE,aString2DE,FileNameDE);
  61.  
  62. var
  63.   PathName: string[67];    { for the pull-down directory }
  64.   DataEntryOattr,          { Output attribute }
  65.   DataEntryIattr,          { Input  attribute }
  66.   DataWndwIattr,           { Input  attribute }
  67.   DataWndwOattr,           { Output attribute }
  68.   DataWndwBattr:  byte;    { Border attribute }
  69.   DataWndwBrdr:   Borders;
  70.  
  71.  
  72. IMPLEMENTATION
  73.  
  74. { ================ Set up your Error Message Lines here: ================== }
  75. { Error Messages are used for indicating that data entry was invalid or out }
  76. { of range.  ErrMsgLine[1] is reserved for custom error messages that you   }
  77. { can create at runtime.  Messages up to InvalidEM are reserved and must    }
  78. { match those in PULL.PAS.                                                  }
  79. { ------------------------------------------------------------------------- }
  80. type
  81.   ErrMsgNames = (NoEM,UserEM,InvalidEM,PathEM,RealEM,CharEM,StrEM);
  82.  
  83. {$ifdef UseMsgLineCode }
  84. procedure GetErrMsgs;
  85. begin
  86.   AutoNumLock := false;   { If true, turns on NumLock on with data entry }
  87.   CapsLockCol := 41;      { First column for ' CAPS NUM SCROLL ' on MsgLine. }
  88.  
  89.   ErrMsgLine[ord(InvalidEM)]:=' Invalid entry.             ESC-acknowledge';
  90.   ErrMsgLine[ord(PathEM)]   :=' Invalid path.  Use [d:][path].  Press ESC.';
  91.   ErrMsgLine[ord(RealEM)]   :=' Range: <=4.0e12            ESC-acknowledge';
  92.   ErrMsgLine[ord(CharEM)]   :=' "?" not allowed            ESC-acknowledge';
  93.   ErrMsgLine[ord(StrEM)]    :=' At least 3 chars required. ESC-acknowledge';
  94. end;
  95.  
  96. {$endif UseMsgLineCode }
  97.  
  98. procedure MakeErrMsg (Low,High: longint);
  99. begin
  100.   {$ifdef UseMsgLineCode }
  101.   DataPad.ErrMsg := ord(UserEM);
  102.   ErrMsgLine[ord(UserEM)] :=
  103.     'Range: '+StrL(Low)+' to '+StrL(High)+'.  Press ESC';
  104.   {$endif }
  105. end;
  106.  
  107. { ====================== Data Entry Range Checking ========================== }
  108. { These procedures are completely defined by the user.  They may not even be  }
  109. { necessary if the string entered is satisfactory as a valid number.  The     }
  110. { calls must be forced to FAR because they are called indirectly.             }
  111. { "Translate" can alter each key from the keyboard before it gets evaluated.  }
  112. { "Verify" will check the range or even completely alter the entire string.   }
  113. { --------------------------------------------------------------------------- }
  114.  
  115. {$F+}
  116. procedure VerifyPath;
  117. begin
  118.   with DataPad do
  119.     begin
  120.       {$I-} ChDir (Sdata); {$I+}     { Check for valid directory }
  121.       if IOresult<>0 then
  122.         ErrMsg := ord(PathEM)
  123.       else GetDir (0,PathName);      { Have DOS parrot the path name }
  124.     end;
  125. end;
  126.  
  127. procedure VerifyFileMask;
  128. begin
  129.   with DataPad do
  130.     if Sdata='' then
  131.       Sdata:='*.*';
  132. end;
  133.  
  134. procedure VerifyPriceLimit;
  135. begin
  136.   with DataPad do
  137.     if ((Idata>25000) or (Idata<=0)) then
  138.       MakeErrMsg (1,25000);
  139. end;
  140.  
  141. procedure VerifyMonth;
  142. begin
  143.   with DataPad do
  144.     if ((Bdata=0) or (Bdata>12)) then
  145.       MakeErrMsg (1,12);
  146. end;
  147.  
  148. procedure VerifyDay;
  149. begin
  150.   with DataPad do
  151.     if ((Bdata=0) or (Bdata>31)) then
  152.       MakeErrMsg (1,31);
  153. end;
  154.  
  155. procedure VerifyYear;
  156. begin
  157.   with DataPad do
  158.     if ((Idata<1960) or (Idata>2010)) then
  159.       MakeErrMsg (1960,2010);
  160. end;
  161.  
  162. procedure VerifyYears;
  163. begin
  164.   with DataPad do
  165.     if ((Idata<4) or (Idata>30)) then
  166.       MakeErrMsg (4,30);
  167. end;
  168.  
  169. { -------------------- Work Window Data Entry Checking ---------------------- }
  170.  
  171. procedure TranslateCase;
  172. begin
  173.   if not ExtKey then
  174.     Key := upcase(Key);        { Simple upper case translation }
  175. end;
  176.  
  177. procedure VerifyByte2;
  178. begin
  179.   with DataPad do
  180.     if ((Bdata>200) or (Bdata=0)) then
  181.       MakeErrMsg (1,200);
  182. end;
  183.  
  184. procedure VerifyWord2;
  185. begin
  186.   with DataPad do
  187.     if ((Wdata>45000) or (Wdata=0)) then
  188.       MakeErrMsg (1,45000);
  189. end;
  190.  
  191. procedure VerifyShortInt2;
  192. begin
  193.   with DataPad do
  194.     if ((SIdata>101) or (SIdata<-50)) then
  195.       MakeErrMsg (-50,101);
  196. end;
  197.  
  198. procedure VerifyInteger2;
  199. begin
  200.   with DataPad do
  201.     if ((Idata>20000) or (Idata<-10000)) then
  202.       MakeErrMsg (-10000,20000);
  203. end;
  204.  
  205. procedure VerifyLongInt2;
  206. begin
  207.   with DataPad do
  208.     if ((Ldata>850000) or (Ldata<-1000000)) then
  209.       MakeErrMsg (-1000000,850000);
  210. end;
  211.  
  212. procedure VerifyReal2;
  213. begin
  214.   with DataPad do
  215.     if (Rdata>4.0e12) then
  216.       ErrMsg := ord(RealEM);
  217. end;
  218.  
  219. procedure VerifyChar2;
  220. begin
  221.   with DataPad do
  222.     if (Cdata='?') then
  223.       ErrMsg := ord(CharEM);
  224. end;
  225.  
  226. procedure VerifyString2;
  227. begin
  228.   with DataPad do
  229.     if ord(Sdata[0])<3 then
  230.       ErrMsg := ord(StrEM);
  231. end;
  232.  
  233. {$F-}
  234.  
  235. { ======================== GetUserDataEntry ================================= }
  236. { The major configurations for all menus go here.  The program first clears   }
  237. { all RECORD values to $00.  The values below will set new values. Therefore, }
  238. { setting RECORD values to "false", nil, or the like is not necessary.        }
  239. { --------------------------------------------------------------------------- }
  240.  
  241. { Code saving utilities: }
  242. procedure GetDataWndw (Index: word);
  243. begin
  244.   DWI := Index;
  245.   TopDataWndw := DataWndw^[DWI];
  246. end;
  247.  
  248. procedure SaveDataWndw;
  249. begin
  250.   DataWndw^[DWI] := TopDataWndw;
  251. end;
  252.  
  253. procedure GetDataEntry (Index: word);
  254. begin
  255.   DEI := Index;
  256.   TopEntry := DataEntry^[DEI];
  257. end;
  258.  
  259. procedure SaveDataEntry;
  260. begin
  261.   DataEntry^[DEI] := TopEntry;
  262. end;
  263.  
  264. procedure GetDataEntryStats;
  265. begin
  266.  
  267.   { ------------- Set up your PULL-DOWN Data Windows here: ------------------ }
  268.   { Justification will default with numbers right justified and string to  }
  269.   { the left if none is specified.                                         }
  270.  
  271.   with TopDataWndw,TopDataWndw.Entry do
  272.     begin
  273.  
  274.       GetDataWndw (ord(BytesDW));